home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue38 / Survive / dmDemo.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-08-25  |  7.5 KB  |  271 lines
  1. unit dmDemo;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   DBTables, Db;
  8.  
  9. type
  10.   TCodeTablesCache = class(TStringList)
  11.   protected
  12.     procedure FreeObjects;
  13.   public
  14.     constructor Create;
  15.     destructor Destroy; override;
  16.     procedure Clear; override;
  17.     function GetCodeDesc(aTableName, aCode: string): string;
  18.     procedure GetCodeTable(aTableName: string; aTableList: TStrings);
  19.     procedure GetCodeTableDescs(aTableName: string; aTableList: TStrings);
  20.     function GetCodeValueFromDesc(aTableName, aCodeDesc: string): string;
  21.     procedure Load;
  22.   end;
  23.  
  24.   TDemoDM = class(TDataModule)
  25.     Database1: TDatabase;
  26.     qryQualifiers: TQuery;
  27.     qryQualifiersQuaCode: TStringField;
  28.     qryQualifiersquaFilterID: TSmallintField;
  29.     qryQualifiersQuaFilterName: TStringField;
  30.     qryQualifiersquaRecID: TAutoIncField;
  31.     qryQualifiersquaID: TSmallintField;
  32.     dsQualifiers: TDataSource;
  33.     upsQualifiers: TUpdateSQL;
  34.     qryFilterNameLookup: TQuery;
  35.     qryFilterNameLookupqlfID: TSmallintField;
  36.     qryFilterNameLookupqlfDescription: TStringField;
  37.     qryFilterNameLookupqlfCodeTable: TStringField;
  38.     qryQuaIDLookup: TQuery;
  39.     qryMaxQuaIDLookup: TQuery;
  40.     qryQualifiersqlfCodeTable: TStringField;
  41.     procedure qryQualifiersAfterOpen(DataSet: TDataSet);
  42.     procedure qryQualifiersAfterScroll(DataSet: TDataSet);
  43.     procedure qryQualifiersAfterClose(DataSet: TDataSet);
  44.     procedure qryQualifiersQuaFilterIDChange(Sender: TField);
  45.     procedure DemoDMCreate(Sender: TObject);
  46.     procedure DemoDMDestroy(Sender: TObject);
  47.     procedure qryQualifiersQuaCodeGetText(Sender: TField; var Text: String;
  48.       DisplayText: Boolean);
  49.     procedure qryQualifiersQuaCodeSetText(Sender: TField;
  50.       const Text: String);
  51.   private
  52.   protected
  53.     CodeTablesCache: TCodeTablesCache;
  54.     procedure LoadPickList;
  55.   public
  56.   end;
  57.  
  58. var
  59.   DemoDM: TDemoDM;
  60.  
  61. implementation
  62.  
  63. uses Demo1;
  64.  
  65. {$R *.DFM}
  66.  
  67. { TCodeTablesCache }
  68.  
  69. { The code values cache is simply a list of all possible code values and
  70.   their descriptions for all filter fields available for use.  This data
  71.   seldom changes and it greatly simplifies coding and performance if we avoid
  72.   data-aware lookup fields and handle the code values internally.
  73.  
  74.   The code value cache structure is a nested stringlist of stringlists.
  75.   We start with a single stringlist containing names for all the code tables.
  76.   The Object property of each string list entry then points to another
  77.   stringlist containing the actual code values and descriptions (in the form
  78.   <value>=<description>) for that code table. }
  79.  
  80. constructor TCodeTablesCache.Create;
  81. begin
  82.   inherited Create;
  83.   Sorted := True;
  84. end;
  85.  
  86. destructor TCodeTablesCache.Destroy;
  87. begin
  88.   FreeObjects;
  89.   inherited Destroy;
  90. end;
  91.  
  92. procedure TCodeTablesCache.Clear;
  93. begin
  94.   FreeObjects;
  95.   inherited Clear;
  96. end;
  97.  
  98. procedure TCodeTablesCache.FreeObjects;
  99. var
  100.   I: Integer;
  101. begin
  102.   for I := 0 to Count - 1 do
  103.     TStringList(Objects[I]).Free;
  104. end;
  105.  
  106. function TCodeTablesCache.GetCodeDesc(aTableName, aCode: string): string;
  107. { Given a code table and code value, returns the description for that code }
  108. var
  109.   I: Integer;
  110. begin
  111.   I := IndexOf(aTableName);
  112.   if I <> -1 then
  113.     with TStrings(Objects[I]) do
  114.       Result := Values[aCode];
  115. end;
  116.  
  117. procedure TCodeTablesCache.GetCodeTable(aTableName: string; aTableList: TStrings);
  118. { Given a code table name, returns the full list of code values and descriptions }
  119. var
  120.   I: Integer;
  121. begin
  122.   I := IndexOf(aTableName);
  123.   if I <> -1 then
  124.     aTableList.AddStrings(TStrings(Objects[I]));
  125. end;
  126.  
  127. procedure TCodeTablesCache.GetCodeTableDescs(aTableName: string; aTableList: TStrings);
  128. { Given a code table name, returns the full list of code descriptions only. }
  129. var
  130.   I, J: Integer;
  131. begin
  132.   I := IndexOf(aTableName);
  133.   if I <> -1 then
  134.     with TStrings(Objects[I]) do
  135.       for J := 0 to Count - 1 do
  136.         aTableList.Add(Values[Names[J]]);
  137. end;
  138.  
  139. function TCodeTablesCache.GetCodeValueFromDesc(aTableName, aCodeDesc: string): string;
  140. { Given a code table name and code description, returns the code value for that
  141.   description. }
  142. var
  143.   I, J: Integer;
  144. begin
  145.   I := IndexOf(aTableName);
  146.   if I <> -1 then
  147.     with TStrings(Objects[I]) do
  148.       for J := 0 to Count - 1 do
  149.         if CompareText(Values[Names[J]], aCodeDesc) = 0 then
  150.         begin
  151.           Result := Names[J];
  152.           Break;
  153.         end;
  154. end;
  155.  
  156. procedure TCodeTablesCache.Load;
  157. { Loads the code table cache from the database }
  158. var
  159.   I: Integer;
  160. begin
  161.   Clear;
  162.   with TQuery.Create(nil) do
  163.     try
  164.       DatabaseName := 'Test';
  165.  
  166.       { First, get list of all code tables used by all available filter fields }
  167.       SQL.Clear;
  168.       SQL.Add('SELECT DISTINCT qlfCodeTable');
  169.       SQL.Add('  FROM QualifierFilters');
  170.       SQL.Add('  ORDER BY qlfCodeTable');
  171.       Open;
  172.       while not Eof do
  173.       begin
  174.         Add(Fields[0].AsString);
  175.         Next;
  176.       end;
  177.       Close;
  178.  
  179.       { Now, go get all the code values and descriptions for each code table }
  180.       SQL.Clear;
  181.       SQL.Add('SELECT codCode, codDesc FROM SystemCodes');
  182.       SQL.Add('  WHERE codTable = :CodeTable');
  183.       SQL.Add('  ORDER BY codDesc');
  184.       for I := 0 to Count - 1 do
  185.       begin
  186.         Objects[I] := TStringList.Create;
  187.         Params[0].AsString := Strings[I];
  188.         Open;
  189.         while not Eof do
  190.         begin
  191.           TStrings(Objects[I]).Add(Format('%s=%s', [Fields[0].AsString, Fields[1].AsString]));
  192.           Next;
  193.         end;
  194.         Close;
  195.       end;
  196.     finally
  197.       Free;
  198.     end;
  199. end;
  200.  
  201. { TDemoDM }
  202.  
  203. procedure TDemoDM.LoadPickList;
  204. begin
  205.   with frmMain.DBGrid1.Columns[1] do
  206.   begin
  207.     PickList.Clear;
  208.     CodeTablesCache.GetCodeTableDescs(qryQualifiersQlfCodeTable.AsString, PickList);
  209.   end;
  210. end;
  211.  
  212. procedure TDemoDM.qryQualifiersAfterOpen(DataSet: TDataSet);
  213. begin
  214.   qryFilterNameLookup.Open;
  215. end;
  216.  
  217. procedure TDemoDM.qryQualifiersAfterScroll(DataSet: TDataSet);
  218. { Whenever we move to a new row, we need to set up the code value
  219.   pick list applicable to the filter field defined in that row. }
  220. begin
  221.   LoadPickList;
  222. end;
  223.  
  224. procedure TDemoDM.qryQualifiersAfterClose(DataSet: TDataSet);
  225. begin
  226.   qryFilterNameLookup.Close;
  227. end;
  228.  
  229. procedure TDemoDM.qryQualifiersQuaFilterIDChange(Sender: TField);
  230. { Whenever we select or change a filter, we need to set the code table
  231.   association too. }
  232. begin
  233.   qryFilterNameLookup.Locate('qlfID', qryQualifiers.FieldByName('quaFilterID').Value, []);
  234.   qryQualifiersQlfCodeTable.AsString := qryFilterNameLookupQlfCodeTable.AsString;
  235.   LoadPickList;
  236.  
  237.   { Whatever code value we had is no longer relevant }
  238.   qryQualifiersQuaCode.AsString := '';
  239. end;
  240.  
  241. procedure TDemoDM.DemoDMCreate(Sender: TObject);
  242. begin
  243.   CodeTablesCache := TCodeTablesCache.Create;
  244.   CodeTablesCache.Load;
  245. end;
  246.  
  247. procedure TDemoDM.DemoDMDestroy(Sender: TObject);
  248. begin
  249.   CodeTablesCache.Free;
  250. end;
  251.  
  252. procedure TDemoDM.qryQualifiersQuaCodeGetText(Sender: TField;
  253.   var Text: String; DisplayText: Boolean);
  254. { We display code description, but store code value }
  255. begin
  256.   if Trim(Sender.AsString) = '' then
  257.     Text := ''
  258.   else
  259.     Text := CodeTablesCache.GetCodeDesc(qryQualifiersQlfCodeTable.AsString, Sender.AsString);
  260. end;
  261.  
  262. procedure TDemoDM.qryQualifiersQuaCodeSetText(Sender: TField;
  263.   const Text: String);
  264. { We display code description, but store code value }
  265. begin
  266.   Sender.AsString :=
  267.     CodeTablesCache.GetCodeValueFromDesc(qryQualifiersQlfCodeTable.AsString, Text);
  268. end;
  269.  
  270. end.
  271.